home *** CD-ROM | disk | FTP | other *** search
/ Programmer Power Tools / Programmer Power Tools.iso / modula2 / mod2src.arc / REAL2FIL.MOD < prev    next >
Text File  |  1987-03-25  |  6KB  |  193 lines

  1. IMPLEMENTATION MODULE Real2Fil;
  2.  
  3. (*           Copyright (c) 1987 - Coronado Enterprises             *)
  4.  
  5. FROM ASCII       IMPORT EOL;
  6. FROM FileSystem  IMPORT File, WriteChar;
  7. FROM Conversions IMPORT ConvertCardinal, ConvertInteger,
  8.                         ConvertOctal, ConvertHex;
  9.  
  10. VAR OutString : ARRAY[0..80] OF CHAR;
  11.  
  12.  
  13.  
  14. PROCEDURE WriteLnFile(VAR FileName : File);
  15. BEGIN
  16.    WriteChar(FileName,EOL);
  17. END WriteLnFile;
  18.  
  19.  
  20.  
  21. PROCEDURE WriteStringFile(VAR FileName : File;
  22.                           String   : ARRAY OF CHAR);
  23. VAR Index : CARDINAL;
  24. BEGIN
  25.    Index := 0;
  26.    WHILE String[Index] <> 000C DO
  27.       WriteChar(FileName,String[Index]);
  28.       Index := Index + 1;
  29.    END;
  30. END WriteStringFile;
  31.  
  32.  
  33.  
  34. PROCEDURE WriteCardFile(VAR FileName : File;
  35.                         DataOut  : CARDINAL;
  36.                         FieldSize : CARDINAL);
  37. VAR Index : CARDINAL;
  38. BEGIN
  39.    ConvertCardinal(DataOut,6,OutString);
  40.    WHILE FieldSize > 6 DO
  41.       WriteChar(FileName," ");
  42.       FieldSize := FieldSize - 1;
  43.    END;
  44.    FOR Index := 0 TO 5 DO
  45.       IF (OutString[Index] <> " ") OR ((6 - Index) <= FieldSize) THEN
  46.          WriteChar(FileName,OutString[Index]);
  47.       END;
  48.    END;
  49. END WriteCardFile;
  50.  
  51.  
  52.  
  53. PROCEDURE WriteIntFile(VAR FileName : File;
  54.                        DataOut  : INTEGER;
  55.                        FieldSize : CARDINAL);
  56. VAR Index : CARDINAL;
  57. BEGIN
  58.    ConvertInteger(DataOut,6,OutString);
  59.    WHILE FieldSize > 6 DO
  60.       WriteChar(FileName," ");
  61.       FieldSize := FieldSize - 1;
  62.    END;
  63.    FOR Index := 0 TO 5 DO
  64.       IF (OutString[Index] <> " ") OR ((6 - Index) <= FieldSize) THEN
  65.          WriteChar(FileName,OutString[Index]);
  66.       END;
  67.    END;
  68. END WriteIntFile;
  69.  
  70.  
  71.  
  72. PROCEDURE WriteOctFile(VAR FileName : File;
  73.                        DataOut  : CARDINAL;
  74.                        FieldSize : CARDINAL);
  75. VAR Index : CARDINAL;
  76. BEGIN
  77.    ConvertOctal(DataOut,6,OutString);
  78.    WHILE FieldSize > 6 DO
  79.       WriteChar(FileName," ");
  80.       FieldSize := FieldSize - 1;
  81.    END;
  82.    FOR Index := (6 - FieldSize) TO 5 DO
  83.       WriteChar(FileName,OutString[Index]);
  84.    END;
  85. END WriteOctFile;
  86.  
  87.  
  88.  
  89. PROCEDURE WriteHexFile(VAR FileName : File;
  90.                        DataOut  : CARDINAL;
  91.                        FieldSize : CARDINAL);
  92. VAR Index : CARDINAL;
  93. BEGIN
  94.    ConvertHex(DataOut,4,OutString);
  95.    WHILE FieldSize > 4 DO
  96.       WriteChar(FileName," ");
  97.       FieldSize := FieldSize - 1;
  98.    END;
  99.    FOR Index := (4 - FieldSize) TO 3 DO
  100.       WriteChar(FileName,OutString[Index]);
  101.    END;
  102. END WriteHexFile;
  103.  
  104.  
  105. (* This procedure uses a rather lengthy method for decomposing the *)
  106. (* REAL number and forming it into single characters.  There is a  *)
  107. (* procedure available in the Logitech library to do this for you  *)
  108. (* but this method is kept as an example of how to decompose the   *)
  109. (* number to prepare it for output.  It could be much more effi-   *)
  110. (* cient to use the Logitech library call. The Procedure is named  *)
  111. (* RealConversions.RealTOString, see your library reference.       *)
  112.  
  113. PROCEDURE WriteRealFile(VAR FileName : File;
  114.                         DataOut  : REAL;
  115.                         FieldSize : CARDINAL;
  116.                         Digits    : CARDINAL);
  117.  
  118. VAR Index          : CARDINAL;
  119.     Field          : CARDINAL;
  120.     Count          : CARDINAL;
  121.     WholeFieldSize : CARDINAL;
  122.     ABSDataOut     : REAL;
  123.     Char           : CHAR;
  124.     RoundReal      : REAL;
  125.  
  126. BEGIN
  127.    IF DataOut >= 0.0 THEN   (* Get the absolute value to work with *)
  128.       ABSDataOut := DataOut;
  129.    ELSE
  130.       ABSDataOut := -DataOut;
  131.    END;
  132.  
  133.                          (* Make sure the Digits field is positive *)
  134.    IF Digits < 0 THEN
  135.       Digits := 0;
  136.    END;
  137.  
  138.         (* Make sure there are 3 or more digits for the whole part *)
  139.    IF (FieldSize - Digits) < 3 THEN
  140.       FieldSize := Digits + 3;
  141.    END;
  142.  
  143.    RoundReal := 0.5;         (* This is used for rounding the data *)
  144.    IF Digits = 0 THEN
  145.       WholeFieldSize := FieldSize;
  146.    ELSE
  147.       WholeFieldSize := FieldSize - Digits - 1;
  148.       FOR Count := 1 TO Digits DO
  149.          RoundReal := RoundReal * 0.1;    (* Reduce for each digit *)
  150.       END;
  151.    END;
  152.    ABSDataOut := ABSDataOut + RoundReal;    (* Add rounding amount *)
  153.  
  154.    Count := 0;
  155.    WHILE ABSDataOut >= 1.0 DO
  156.       Count := Count + 1;              (* Count significant digits *)
  157.       ABSDataOut := 0.1 * ABSDataOut;
  158.    END;
  159.  
  160.    WHILE WholeFieldSize > (Count + 1) DO  (* Output leading blanks *)
  161.       WriteChar(FileName," ");
  162.       WholeFieldSize := WholeFieldSize - 1;
  163.    END;
  164.  
  165.    IF DataOut >= 0.0 THEN          (* Output the sign (- or blank) *)
  166.       WriteChar(FileName," ");
  167.    ELSE
  168.       WriteChar(FileName,"-");
  169.    END;
  170.  
  171.    WHILE Count > 0 DO       (* Output the whole part of the number *)
  172.       ABSDataOut := 10.0 * ABSDataOut;
  173.       Index := TRUNC(ABSDataOut);
  174.       Char := CHR(Index + 48);                   (* 48 = ASCII '0' *)
  175.       WriteChar(FileName,Char);
  176.       ABSDataOut := ABSDataOut - FLOAT(Index);
  177.       Count := Count - 1;
  178.    END;
  179.  
  180.    IF Digits > 0 THEN  (* Output the fractional part of the number *)
  181.       WriteChar(FileName,'.');
  182.       FOR Count := 1 TO Digits DO
  183.          ABSDataOut := 10.0 * ABSDataOut;
  184.          Index := TRUNC(ABSDataOut);
  185.          Char := CHR(Index + 48);                (* 48 = ASCII '0' *)
  186.          WriteChar(FileName,Char);
  187.          ABSDataOut := ABSDataOut - FLOAT(Index);
  188.       END;
  189.    END;
  190. END WriteRealFile;
  191.  
  192. END Real2Fil.
  193.